home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr52 / pdxvie.zip / READDB.PRG < prev    next >
Text File  |  1993-04-01  |  20KB  |  694 lines
  1. * This program has been altered by Kevin S. Gallagher
  2. * Compile...: /a/w/m/n
  3. * Link......: warplink
  4. *╔══════════════════════════════════════════════════════════════════╗*
  5. *║   System Name:   Paradox (r) viewing program                     ║*
  6. *║   Module Name:   READDB.PRG                                      ║*
  7. *║                                                                  ║*
  8. *║   Description:   Program to show that you can basically browse   ║*
  9. *║                  anything with a little imagination and a lot    ║*
  10. *║                  of patience (a lot of patience)                 ║*
  11. *║                                                                  ║*
  12. *║   Notes......:   ****  THIS IS NOT AN RDD  ****                  ║*
  13. *║                                                                  ║*
  14. *║                  Syntax:    READDB <database>.db                 ║*
  15. *║                                                                  ║*
  16. *║                  Read the READDB.TXT file please.                ║*
  17. *║                  ** Compile with the /w/a switches. **           ║*
  18. *║                                                                  ║*
  19. *║   Author.....:   Micheal Todd Charron                            ║*
  20. *║                                                                  ║*
  21. *║   Date.......:   April 15, 1990                                  ║*
  22. *║                                                                  ║*
  23. *║   History....:   I kept telling user groups that you can         ║*
  24. *║                  use TBrowse to browse anything you want to.     ║*
  25. *║                  I decided that before the Paradox (r) RDD       ║*
  26. *║                  came out that I would make a Paradox (r).       ║*
  27. *║            viewer.  Two weeks of working on it when I              ║*
  28. *║                  had time.                                       ║*
  29. *║                                                                  ║*
  30. *║   Copyright..:   (c) Micro Tech Consultant Services, 1991        ║*
  31. *║                  (c) The people at Nantucket Canada, 1991        ║*
  32. *║                  Is this possible?                               ║*
  33. *╚══════════════════════════════════════════════════════════════════╝*
  34. #include "inkey.ch"
  35. #include "funcs.ch"
  36. #include "its501.ch"
  37. ************************************************************************
  38.  
  39. //  Defines the locations of data in the main array  \\
  40. #define mRecSize        aPDXInfo[ 1 ]
  41. #define mNoInSection        aPDXInfo[ 2 ]
  42. #define mNoOfRecords        aPDXInfo[ 3 ]
  43. #define mNoOfFields        aPDXInfo[ 4 ]
  44. #define mFieldInfo        aPDXInfo[ 5 ]
  45.  
  46. //  Defines the Ascii representation of Field Types  \\
  47. #define mTypeNumeric        6
  48. #define mTypeCurrency        5
  49. #define mTypeInteger        3
  50. #define mTypeDate        2
  51. #define mTypeCharacter        1
  52.  
  53. //  Defines variables that are visable to the whole .PRG  \\
  54. //  Array which contains the database structure information  \\
  55. STATIC aPDXInfo
  56. //  Character string of a complete record  \\
  57. STATIC cPDXRecord
  58. //  Numeric variable with the database's file handle in it  \\
  59. STATIC nRead
  60.  
  61. FUNCTION Main( cFileName )
  62.     LOCAL nI, nKey, nPDXPos := 1, nRecCountLen
  63.     //  Defines my main TBrowse table  \\
  64.     LOCAL oBrowse := TBROWSENEW( 2, 3, 19, 74 )
  65.  
  66.     //  Turns the cursor off and clears the screen  \\
  67.     SETCURSOR( 0 )
  68.     CLS
  69.  
  70.     //  Open the database file and assign the file handle to `nRead'  \\
  71.     nRead := FOPEN( cFileName )
  72.     //  Check to see if an error has occurred  \\
  73.     IF nRead == -1
  74.         ? 'File cannot be read!'
  75.         QUIT
  76.     ENDIF
  77.  
  78.     //  Psuedo function which draws a background and displays message  \\
  79.     Panel( .T. )
  80.     //  Draws a double lined box with a shadow under it  \\
  81.     Shad( 1, 2, 21, 75, .T., 'w+/b' )
  82.  
  83.     SETCOLOR( 'gr+/b' )
  84.     //  Displays the database's name in the info area
  85.     @20, 5 SAY UPPER( cFileName )
  86.  
  87.     //  Defines the TBrowse's color  \\
  88.     oBrowse:COLORSPEC := 'w+/b'
  89.     //  Defines the TBrowse's column, heading, and footing separators  \\
  90.     oBrowse:COLSEP := ' │ '
  91.     oBrowse:HEADSEP := '═╤═'
  92.     oBrowse:FOOTSEP := '═╧═'
  93.  
  94.     //  Retrieves the database's file structure  \\
  95.     aPDXInfo := PDXHeader()
  96.  
  97.     //  Adds new columns to the TBrowse  \\
  98.     FOR nI := 1 TO mNoOfFields
  99.         //  Macro expands the code block to use the iteration \\
  100.         //  value of the counter                              \\
  101.         oBrowse:ADDCOLUMN( TBCOLUMNNEW( mFieldInfo[ nI, 4 ],;
  102.             &( '{ || PDXField(' +  LTRIM( STR( nI ) ) + ') }' ) ) )
  103.     NEXT nI
  104.  
  105.     //  Determines how many spaces the number of records will take \\
  106.     nRecCountLen := LEN( LTRIM( STR( mNoOfRecords ) ) )
  107.     //  Display the number of records
  108.     @20, 72 - nRecCountLen - 5 SAY '1 of ' + LTRIM( STR( mNoOfRecords ) )
  109.  
  110.     //  Defines the code block that moves through the PDX file  \\
  111.     oBrowse:SKIPBLOCK := { | nMove | SkipPDX( nMove, @nPDXPos ) }
  112.     
  113.     //  Returns the TBrowse to the first record  \\
  114.     oBrowse:GOTOPBLOCK := { || nPDXPos := 1, FSEEK( nRead, 2054, 0 ),;
  115.         cPDXRecord := ReadIn( nRead, mRecSize ) }
  116.  
  117.     //  Positions the file pointer to the first record  \\
  118.     FSEEK( nRead, 2054, 0 )
  119.     //  Reads in the record to the character string  \\
  120.      cPDXRecord := ReadIn( nRead, mRecSize )
  121.  
  122.     DO WHILE .T.
  123.         //  Runs through the loop until the TBrowse  \\
  124.         //  is Stable                                 \\
  125.         DO WHILE ! ( oBrowse:STABILIZE() )
  126.         ENDDO
  127.  
  128.         //  Unfortunately this is one of those weird ones I  \\
  129.         //  cannot explain.  The color of the next @...SAY   \\
  130.         //  seems to be taken from the COLORSPEC, I think.   \\
  131.         //  If I put SETCOLOR() on the next line everthing   \\
  132.         //  works fine.
  133.         SETCOLOR()
  134.         //  Displays the current record number  \\
  135.         @20, 72 - ( nRecCountLen * 2 ) - 4 SAY PADL( nPDXPos,;
  136.             nRecCountLen )
  137.  
  138.         //  Waits for a Keypress  \\
  139.         nKey := INKEY( 0 )
  140.  
  141.         DO CASE
  142.         //  Calls up a the main help screen  \\
  143.         CASE nKey == K_F1
  144.             HelpScreen( 1 )
  145.  
  146.         //  Calls up the field info screen  \\
  147.         CASE nKey == K_F2
  148.             FieldDisplay()
  149.  
  150.         //  Moves up one row  \\
  151.         CASE nKey == K_UP
  152.             oBrowse:UP()
  153.  
  154.         //  Moves down one row  \\
  155.         CASE nKey == K_DOWN
  156.             oBrowse:DOWN()
  157.  
  158.         //  Moves right one column  \\
  159.         CASE nKey == K_RIGHT
  160.             oBrowse:RIGHT()
  161.  
  162.         //  Moves left one column  \\
  163.         CASE nKey == K_LEFT
  164.             oBrowse:LEFT()
  165.  
  166.         //  Moves down one screen  \\
  167.         CASE nKey == K_PGDN
  168.             oBrowse:PAGEDOWN()
  169.  
  170.         //  Moves up one screen  \\
  171.         CASE nKey == K_PGUP
  172.             oBrowse:PAGEUP()
  173.  
  174.         //  Moves to the first record  \\
  175.         CASE nKey == K_HOME
  176.             oBrowse:GOTOP()
  177.  
  178.         //  Ask the user whether to exit or not  \\
  179.         CASE nKey == K_F10
  180.             IF TimeToExit()
  181.                 EXIT
  182.             ENDIF
  183.  
  184.         ENDCASE
  185.     ENDDO
  186.  
  187.     //  Closes the database file  \\
  188.     FCLOSE( nRead )
  189.  
  190.     //  Draws the credits screen  \\
  191.     Credit()
  192.     //  Turns the cursor off  \\
  193.     SETCURSOR( 1 )
  194.  
  195. //  Ends the program  \\
  196. RETURN Nil
  197.  
  198.  
  199. * * * *
  200. *
  201. *    Function ReadIn()
  202. *
  203. //  Reads in `nLength' of bytes from the file and returns them.  This    \\
  204. //  differs in FREADSTR() because it does not stop at a null character.  \\
  205. FUNCTION ReadIn( nRead, nLength )
  206.     LOCAL cBuffer := SPACE( nLength )
  207.  
  208.     FREAD( nRead, @cBuffer, nLength )
  209.  
  210. RETURN cBuffer
  211.  
  212.  
  213.  
  214. * * * *
  215. *
  216. *    Function IEEEToNumb()
  217. *
  218. //  Converts IEEE format numbers to floating point          \\
  219. //  Don't ask me to explain this function because I won't.  \\
  220. FUNCTION IEEEToNumb( cNum )
  221.     LOCAL lNeg
  222.     LOCAL nPower, nMant
  223.  
  224.     nPower := ( ( ASC( SUBSTR( cNum, 1, 1 ) ) % 128 ) * 16 ) +;
  225.             INT( ASC( SUBSTR( cNum, 2, 1 ) ) / 16 ) - 1023
  226.     lNeg := ( ASC( SUBSTR( cNum, 1, 1 ) ) / 16 ) < 8
  227.     nMant := 1 + ( ( ASC( SUBSTR( cNum, 2, 1 ) ) % 16 ) / 16 ) +;
  228.         ( BIN2W( SUBSTR( cNum, 4, 1 ) +;
  229.         SUBSTR( cNum, 3, 1 ) ) / ( 65536 * 16 ) ) +;
  230.         ( BIN2W( SUBSTR( cNum, 6, 1 ) +;
  231.         SUBSTR( cNum, 5, 1 ) ) / ( 65536 * 65536 * 16 ) ) +;
  232.         ( BIN2W( SUBSTR( cNum, 8, 1 ) +;
  233.         SUBSTR( cNum, 7, 1 ) ) / ( 65536 * 65536 * 65536 * 16 ) )
  234.  
  235. RETURN ( nMant * ( 2 ^ nPower ) ) * IF( lNeg, -1, 1 )
  236.  
  237.  
  238.  
  239. * * * *
  240. *
  241. *    Function Chr2Numb()
  242. *
  243. //  Converts two and four byte ascii groupings to numbers  \\
  244. FUNCTION Chr2Numb( cVar, nLen )
  245.     LOCAL nI, nRet_Val
  246.  
  247.     IF nLen == 2
  248.         nRet_Val := BIN2I( RIGHT( cVar, 1 ) + LEFT( cVar, 1 ) )
  249.     ELSE
  250.         nRet_Val := BIN2W( RIGHT( cVar, 1 ) + SUBSTR( cVar, 3, 1 ) +;
  251.             SUBSTR( cVar, 2, 1 ) + LEFT( cVar, 1 ) )
  252.     ENDIF
  253. RETURN nRet_Val
  254.  
  255.  
  256.  
  257. * * * *
  258. *
  259. *    Function PDXField()
  260. *
  261. //  Returns the proper data for the function located in the  \\
  262. //  TBCOLUMNNEW code block.                                  \\
  263. FUNCTION PDXField( nField )
  264.     LOCAL xRetBlock
  265.     //  Pulls the info for the current field from aPDXInfo  \\
  266.     LOCAL nLength := mFieldInfo[ nField, 3 ],;
  267.         nStart := mFieldInfo[ nField, 2 ],;
  268.         nType := mFieldInfo[ nField, 1 ]
  269.  
  270.     DO CASE
  271.     CASE nType == mTypeNumeric
  272.         //  Converts IEEE format number to floating point number  \\
  273.         //  and then transforms it with the set picture string    \\
  274.         xRetBlock := TRANSFORM( IEEEToNumb( SUBSTR( cPDXRecord,;
  275.             nStart, 8 ) ), "99999999.99" )
  276.     CASE nType == mTypeCurrency
  277.         //  Converts IEEE format number to floating point number  \\
  278.         //  and then transforms it with the set picture string    \\
  279.         xRetBlock := TRANSFORM( IEEEToNumb( SUBSTR( cPDXRecord,;
  280.             nStart, 8 ) ), "$99,999,999.99" )
  281.     CASE nType == mTypeInteger
  282.         //  Converts the two ascii characters to a integer and  \\
  283.         //  adds 32768 to that integer                          \\
  284.         xRetBlock := 32768 + Chr2Numb( SUBSTR( cPDXRecord, nStart,;
  285.             2 ), 2 )
  286.     CASE nType == mTypeDate
  287.         //  Converts the four Ascii characters to an integer and  \\
  288.         //  adds the date September 30th, 1974 to it              \\
  289.         xRetBlock := Chr2Numb( SUBSTR( cPDXRecord, nStart, 4 ), 4 ) +;
  290.             CTOD( "09/30/74" )
  291.     OTHERWISE
  292.         //  Assigns the character string                           \\
  293.         xRetBlock := SUBSTR( cPDXRecord, nStart, nLength )
  294.     ENDCASE
  295.  
  296. RETURN xRetBlock
  297.  
  298.  
  299.  
  300. * * * *
  301. *
  302. *    Function SkipPDX()
  303. *
  304. //  Defines the movement of the TBrowse and positions the file pointer  \\
  305. FUNCTION SkipPDX( nMove, nPDXPos )
  306.     LOCAL nNoOfSection, nPosInSection
  307.  
  308.     //  Checks to see if the TBrowse is requesting a move past the      \\
  309.     //  number of records and if so, restricts the tbrowse's movements  \\
  310.     IF nMove > 0
  311.         //  If the current position plus the requested move is     \\
  312.         //  greater than the number of records, return the number  \\
  313.         //  of records minus the current record position           \\
  314.         IF ( nPDXPos + nMove ) > mNoOfRecords
  315.             nMove := mNoOfRecords - nPDXPos
  316.         ENDIF
  317.     ELSE
  318.         //  If the current position plus the requested move is   \\
  319.         //  less than the first record, return the number of     \\
  320.         //  records to move back to the first                    \\
  321.         IF ( nPDXPos + nMove ) < 1
  322.             nMove := 1 - nPDXPos
  323.         ENDIF
  324.     ENDIF
  325.  
  326.     //  Add the number of records that the TBrowse is allowed to  \\
  327.     //  move to the current record position                       \\
  328.     nPDXPos += nMove
  329.  
  330.     //  If the TBrowse will move at all, reposition the file pointer  \\
  331.     IF nMove != 0
  332.         //  Determines which 2048 byte section the record is in  \\
  333.         nNoOfSection := INT( nPDXPos / mNoInSection ) +;
  334.             IF( nPDXPos / mNoInSection == 0, 0, 1 )
  335.  
  336.         //  Determines which record in the 2048 byte section it is  \\
  337.         nPosInSection := ( nPDXPos - ( ( nNoOfSection - 1 ) *;
  338.             mNoInSection ) - 1 )
  339.         
  340.         IF nPosInSection == -1
  341.             nPosInSection := 0
  342.         ENDIF
  343.  
  344.         //  Move the file pointer  \\
  345.         FSEEK( nRead, ( nNoOfSection * 2048 ) + 6 +;
  346.             ( nPosInSection * mRecSize ), 0 )
  347.  
  348.         //  Read in the current record  \\
  349.         cPDXRecord := ReadIn( nRead, mRecSize )
  350.     ENDIF
  351.  
  352. RETURN nMove
  353.  
  354.  
  355.  
  356. * * * *
  357. *
  358. *    Function PDXHeader()
  359. *
  360. //  Retrieves the Header information and adds it to an array  \\
  361. FUNCTION PDXHeader()
  362.     LOCAL aPDXInfo := {}
  363.     LOCAL nFileLoc, nI, nLoc := 1
  364.  
  365.     //  Adds the record size to the array  \\
  366.     AADD( aPDXInfo, BIN2L( ReadIn( nRead, 3 ) ) )
  367.     //  Adds the number of records per section  \\
  368.     AADD( aPDXInfo, INT( ( 2042/mRecSize + 1 ) ) )
  369.  
  370.     FSEEK( nRead, 6, 0 )
  371.     //  Adds the record size  \\
  372.     AADD( aPDXInfo, BIN2L( ReadIn( nRead, 4 ) ) )
  373.     FSEEK( nRead, 33, 0 )
  374.  
  375.     //  Adds the number of fields  \\
  376.     AADD( aPDXInfo, BIN2I( ReadIn( nRead, 2 ) ) )
  377.  
  378. *    // Future expansion for records larger that 2048
  379. *    AADD( aPDXInfo, ( INT( mRecSize / 1024 ) + 1 ) * 1024 )
  380.  
  381.     FSEEK( nRead, 88, 0 )
  382.  
  383.     //  Will contain the reference to the Field Info  \\
  384.     //  multi-dimensional array.                      \\
  385.     AADD( aPDXInfo, {} )
  386.  
  387.     FOR nI := 1 TO mNoOfFields
  388.         //  Adds the field type to the array  \\
  389.         AADD( mFieldInfo, { ASC( ReadIn( nRead, 1 ) ) } )
  390.         //  Adds the location in the cPDXRecord string of the field  \\
  391.         AADD( mFieldInfo[ nI ], nLoc )
  392.         //  Adds the length in the cPDXRecord string of the field  \\
  393.         AADD( mFieldInfo[ nI ], ASC( ReadIn( nRead, 1 ) ) )
  394.         //  Assigns the new location to nLoc  \\
  395.         nLoc += mFieldInfo[ nI, 3 ]
  396.     NEXT nI
  397.  
  398.     //  Repositions the file pointer to the start of the field names  \\
  399.     nFileLoc := FSEEK( nRead, ( ( mNoOfFields + 1 ) * 4 ) + 79, 1 )
  400.  
  401.     FOR nI := 1 TO mNoOfFields
  402.         //  Adds the field name  \\
  403.         AADD( mFieldInfo[ nI ], FREADSTR( nRead, 26 ) )
  404.         nFileLoc := FSEEK( nRead, nFileLoc +;
  405.             LEN( mFieldInfo[ nI, 4 ] ) + 1, 0 )
  406.     NEXT nI
  407.  
  408. //  Returns the database information  \\
  409. RETURN aPDXInfo
  410.  
  411.  
  412.  
  413. * * * *
  414. *
  415. *    Function FieldDisplay()
  416. *
  417. //  Displays the field information in a TBrowse  \\
  418. FUNCTION FieldDisplay()
  419.     LOCAL SaveFullScreen()
  420.     LOCAL cDefColor := SETCOLOR( 'gr+/br' )
  421.     LOCAL oBrowse, oColumn
  422.     LOCAL nFieldLen, nFieldPos := 1, nInfoRow, nKey, nNoOfRows, nStartRow
  423.  
  424.     //  Determines the number of rows the tbrowse will need
  425.     nNoOfRows := MIN( mNoOfFields, 7 ) + 1
  426.  
  427.     //  Determines the top line of the TBrowse  \\
  428.     nStartRow := INT( ( 24 - nNoOfRows ) / 2 ) - 2
  429.  
  430.     //  Determines the line for the display of the number of fields \\
  431.     nInfoRow := nStartRow + nNoOfRows + 2
  432.  
  433.     //  Creates the object for the field info browse  \\
  434.     oBrowse := TBROWSENEW( nStartRow, 14, nInfoRow - 1, 61 )
  435.     //  Draws a shadowed box for the field info browse  \\
  436.     BoxShad( ( nStartRow - 1 ), 12, ( nInfoRow + 1 ), 63,;
  437.         'w+/br' )
  438.  
  439.     @nInfoRow, 14 SAY 'FIELDS'
  440.  
  441.     //  Determines the amount of space the number of fields will need  \\
  442.     nFieldLen := LEN( LTRIM( STR( mNoOfFields ) ) )
  443.     @nInfoRow, 62 - nFieldLen - 5 SAY '1 of ' + LTRIM( STR( mNoOfFields ) )
  444.  
  445.     //  Defines the field browse's Head, Column and Footing separators  \\
  446.     oBrowse:HEADSEP := '─┬─'
  447.     oBrowse:COLSEP :=  ' │ '
  448.     oBrowse:FOOTSEP := '─┴─'    
  449.  
  450.     //  Creates the field name column object  \\
  451.     oColumn := TBCOLUMNNEW( PADC( 'NAME', 25 ),;
  452.         { || PADR( mFieldInfo[ nFieldPos, 4 ], 25 ) } )
  453.     //  Specifies the color for the column data  \\
  454.     oColumn:COLORBLOCK := { || { 3, 2 } }
  455.     //  Adds the column object to the TBrowse  \\
  456.     oBrowse:ADDCOLUMN( oColumn )
  457.  
  458.     //  Creates the field type column object  \\
  459.     oColumn := TBCOLUMNNEW( PADC( 'TYPE', 12 ),;
  460.         { || FieldType( mFieldInfo[ nFieldPos, 1 ] ) } )
  461.     //  Specifies the color for the column data  \\
  462.     oColumn:COLORBLOCK := { || { 3, 2 } }
  463.     //  Adds the column object to the TBrowse  \\
  464.     oBrowse:ADDCOLUMN( oColumn )
  465.  
  466.     //  Creates the field length column object  \\
  467.     //  Only AlphaNumeric ( character ) fields have user  \\
  468.     //  definable lengths                                 \\
  469.     oColumn := TBCOLUMNNEW( 'LEN',;
  470.         { || IF( mFieldInfo[ nFieldPos, 1 ] == mTypeCharacter,;
  471.         PADL( mFieldInfo[ nFieldPos, 3 ], 3 ), '   ' ) } )
  472.     //  Specifies the color for the column data  \\
  473.     oColumn:COLORBLOCK := { || { 3, 2 } }
  474.     //  Adds the column object to the TBrowse  \\
  475.     oBrowse:ADDCOLUMN( oColumn )
  476.  
  477.     //  Specifies the overall colors of the TBrowse       \\
  478.     //  NOTE:  The fourth color is for a Clipper 5.0 bug  \\
  479.     oBrowse:COLORSPEC := 'gr+/br, w+/n, w+/br, n/n'
  480.  
  481.     //  Defines the movement through the array  \\
  482.     oBrowse:SKIPBLOCK :=;
  483.         { | nMove | SkipArray( nMove, @nFieldPos, LEN( mFieldInfo ) ) }
  484.  
  485.     DO WHILE .T.
  486.         //  Runs through the loop until the TBrowse  \\
  487.         //  is Stable                                 \\
  488.         DO WHILE ! ( oBrowse:STABILIZE() )
  489.         ENDDO
  490.  
  491.         //  Colors all cells in the current row 'w+/n'  \\
  492.         oBrowse:COLORRECT( { oBrowse:ROWPOS, 1, oBrowse:ROWPOS,;
  493.             oBrowse:COLCOUNT }, { 2, 2 } )
  494.  
  495.         //  Displays the current field number  \\
  496.         @nInfoRow, 62 - ( nFieldLen * 2 ) - 4 SAY PADL( nFieldPos,;
  497.             nFieldLen )
  498.  
  499.         //  Waits for key input  \\
  500.         nKey := INKEY( 0 )
  501.  
  502.         //  Colors all cells in the current row as their  \\
  503.         //  default colors                                \\
  504.         oBrowse:COLORRECT( { oBrowse:ROWPOS, 1, oBrowse:ROWPOS,;
  505.             oBrowse:COLCOUNT }, { 3, 2 } )
  506.  
  507.         DO CASE
  508.         //  Displays a help screen for the field browse  \\
  509.         CASE nKey == K_F1
  510.             HelpScreen( 2 )
  511.  
  512.         //  Do I have to explain the follow four cases?  \\
  513.         CASE nKey == K_UP
  514.             oBrowse:UP()
  515.  
  516.         CASE nKey == K_DOWN
  517.             oBrowse:DOWN()
  518.  
  519.         CASE nKey == K_PGDN
  520.             oBrowse:PAGEDOWN()
  521.  
  522.         CASE nKey == K_PGUP
  523.             oBrowse:PAGEUP()
  524.  
  525.         //  Return to the main browse \\
  526.         CASE nKey == K_ESC
  527.             EXIT
  528.  
  529.         ENDCASE
  530.     ENDDO
  531.  
  532.     SETCOLOR( cDefColor )
  533.     RestFullScreen()
  534.  
  535. RETURN Nil
  536.  
  537.  
  538.  
  539. * * * *
  540. *
  541. *    Function FieldType()
  542. *
  543. //  Returns the field type according to its ascii representation  \\
  544. FUNCTION FieldType( nFieldType )
  545.     LOCAL cRetType
  546.  
  547.     DO CASE
  548.     CASE nFieldType == mTypeCharacter
  549.         cRetType := 'AlphaNumeric'
  550.     CASE nFieldType == mTypeNumeric
  551.         cRetType := 'Number      '
  552.     CASE nFieldType == mTypeInteger
  553.         cRetType := 'Short Number'
  554.     CASE nFieldType == mTypeCurrency
  555.         cRetType := 'Currency    '
  556.     CASE nFieldType == mTypeDate
  557.         cRetType := 'Date        '
  558.     ENDCASE
  559.  
  560. RETURN cRetType
  561.  
  562.  
  563.  
  564. * * * *
  565. *
  566. *    Function SkipArray()
  567. *
  568. //   Controls movement through the browse.
  569. FUNCTION SkipArray( nMove, nArrPos, nArrayLength )
  570.  
  571.     //   Checks to see if the movement will be outside the bounds
  572.     //   of the array and if so, restricts the tbrowse's movements.
  573.     IF nMove > 0
  574.         //   If the current position plus the requested move is
  575.         //   greater than the length of the array return the number
  576.         //   of elements left in the array.
  577.         IF ( nArrPos + nMove ) >  nArrayLength
  578.             nMove := nArrayLength - nArrPos
  579.         ENDIF
  580.     ELSE
  581.         //   If the current position plus the requested move is
  582.         //   pass the start of the array, return the number of 
  583.         //   elements to the start of the array.
  584.         IF ( nArrPos + nMove ) < 1
  585.             nMove := 1 - nArrPos
  586.         ENDIF
  587.     ENDIF
  588.  
  589.     //  Add the number to move to the array position
  590.     nArrPos += nMove
  591.  
  592. RETURN nMove
  593.  
  594.  
  595.  
  596. * * * *
  597. *
  598. *    Function TimeToExit()
  599. *
  600. //  Exit Dialog Box
  601. FUNCTION TimeToExit()
  602.     LOCAL cDefColor := SETCOLOR( 'w+/r' ),;
  603.         cFullScrn := SAVESCREEN( 0, 0, 24, 79 )
  604.     LOCAL nExitCh := 1
  605.  
  606.     BoxShad( 8, 30, 12, 48, 'w+/r' )
  607.  
  608.     @9, 33 SAY 'Do You Really'
  609.     @10, 33 SAY 'Want to Exit?'
  610.     @11, 34 PROMPT ' YES '
  611.     @11, 41 PROMPT ' NO '
  612.     MENU TO nExitCh
  613.  
  614.     SETCOLOR( cDefColor )
  615.     RESTSCREEN( 0, 0, 24, 79, cFullScrn )
  616.  
  617. RETURN IF( nExitCh == 1, .T., .F. )
  618.  
  619.  
  620.  
  621. * * * *
  622. *
  623. *    Function HelpScreen()
  624. *
  625. //  Pops up a help screen  \\
  626. Function HelpScreen( nHelpScreen )
  627.     LOCAL SaveFullScreen()
  628.     LOCAL cDefColor := SETCOLOR( 'r+/r' )
  629.     LOCAL nI
  630.  
  631.     DO CASE
  632.     CASE nHelpScreen == 1
  633.         BoxShad( 5, 25, 17, 51, 'w+/r' )
  634.  
  635.         SETCOLOR( 'r+/r' )
  636.         FOR nI := 7 TO 15
  637.             @nI, 35 SAY '-'
  638.         NEXT nI
  639.         @6, 27 TO 16, 49
  640.         @13, 27 SAY '├─────────────────────┤'
  641.  
  642.         SETCOLOR( 'gr+/r' )
  643.         @7, 33 SAY CHR( 25 )
  644.         @8, 33 SAY CHR( 24 )
  645.         @9, 30 SAY 'PgDn'
  646.         @10, 30 SAY 'PgUp'
  647.         @11, 33 SAY CHR( 26 )
  648.         @12, 33 SAY CHR( 27 )
  649.         @14, 32 SAY 'F2'
  650.         @15, 31 SAY 'F10'
  651.  
  652.         SETCOLOR( 'w+/r' )
  653.         @7, 37 SAY 'Down'
  654.         @8, 37 SAY 'Up'
  655.         @9, 37 SAY 'Page Down'
  656.         @10, 37 SAY 'Page Up'
  657.         @11, 37 SAY 'Right'
  658.         @12, 37 SAY 'Left'
  659.         @14, 37 SAY 'Field Info'
  660.         @15, 37 SAY 'Exit'
  661.  
  662.     CASE nHelpScreen == 2
  663.         BoxShad( 6, 25, 15, 52, 'w+/r' )
  664.  
  665.         SETCOLOR( 'r+/r' )
  666.         FOR nI := 8 TO 13
  667.             @nI, 35 SAY '-'
  668.         NEXT nI
  669.         @7, 27 TO 14, 50
  670.         @12, 27 SAY '├──────────────────────┤'
  671.  
  672.  
  673.         SETCOLOR( 'gr+/r' )
  674.         @8, 33 SAY CHR( 25 )
  675.         @9, 33 SAY CHR( 24 )
  676.         @10, 30 SAY 'PgDn'
  677.         @11, 30 SAY 'PgUp'
  678.         @13, 31 SAY 'ESC'
  679.  
  680.         SETCOLOR( 'w+/r' )
  681.         @8, 37 SAY 'Down'
  682.         @9, 37 SAY 'Up'
  683.         @10, 37 SAY 'Page Down'
  684.         @11, 37 SAY 'Page Up'
  685.         @13, 37 SAY 'Main Screen'
  686.         
  687.     ENDCASE
  688.  
  689.     PressAnyKey()
  690.     RestFullScreen()
  691.     SETCOLOR( cDefColor )
  692.  
  693. RETURN Nil
  694.